home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / dbase / vpi1_330.zip / DEMODISP.PRG < prev    next >
Text File  |  1991-12-30  |  5KB  |  210 lines
  1. **********************************************************************
  2. * DEMODISP.PRG    subroutine demonstrates HANDS-ON file features
  3. *                 called by DEMO.PRG (VP-Info Level 1)
  4. *                                         Tue  12-24-1991  15:45:39
  5. * (C) Copyright 1986-1991 Sub Rosa International Inc.
  6. *  Sid Bursten and Bernie Melman
  7. **********************************************************************
  8. SET talk off
  9. ON escape
  10.    SCOPE#4
  11.    SELECT 1
  12.    SCREEN 1
  13.    WINDOW
  14.    SET save on
  15.    USE democust
  16.    RETURN
  17. ENDON
  18. ?? chr(7)
  19. SELECT 1
  20. USE &tempfile
  21. ii=4
  22. DO WHILE t
  23.    SCREEN 1,2
  24.    SELECT 1
  25.    ii=ii+1
  26.    :color=b2[mod(ii,10)+1]
  27.    WINDOW 7,46,22,77 double
  28.    TEXT
  29.     Here's a "hands-on"
  30.     demonstration of how
  31.     easy it is to work
  32.     with SR-INFO files.
  33.        SELECT BELOW:
  34.  
  35.   0. Return to Main Menu
  36.  
  37.   1. List structure
  38.   2. Edit or Add Records
  39.   3. Edit/Custom Screen
  40.   4. Browse or Add Records
  41.   5. Browse/Custom Screen
  42.   6. Run a report
  43.   7. Account inquiry
  44.    ENDTEXT
  45.    CURSOR 15,47
  46.    ans=menu(7,28)
  47.    WINDOW
  48.    SCREEN 2,1
  49.    ii=ii+1
  50.    :color=b2[mod(ii,10)+1]
  51.    COLOR b2[mod(ii,10)+1] 0 0 24 79
  52.    CURSOR 1,0
  53.    CLEAR gets
  54.    WINDOW
  55.    DO CASE
  56.    CASE ans=0
  57.       SCOPE#4
  58.       SELECT 1
  59.       USE democust
  60.       RETURN
  61.    CASE ans=1
  62.       ERASE
  63.       LIST structure
  64.    CASE ans=2
  65.       EDIT
  66.    CASE ans=3
  67.       WINDOW
  68.       CLS
  69.       DO WHILE t
  70.          EDIT TEXT demoedit
  71.          DO CASE
  72.          CASE :key=335
  73.             BREAK
  74.          CASE eof
  75.             GOTO top
  76.          CASE #<1
  77.             GOTO bottom
  78.             IF eof
  79.                BREAK
  80.             ENDIF
  81.          ENDCASE
  82.       ENDDO
  83.    CASE ans=4
  84.       GO top
  85.       BROWSE
  86.    CASE ans=5
  87.       GO top
  88.       WINDOW
  89.       CLS
  90.       WINDOW 0,16
  91.       BROWSE TEXT demobrow
  92.    CASE ans=6
  93.       SET talk off
  94.       REPORT demo
  95.    CASE ans=7
  96.       PERFORM ddisplay
  97.    ENDCASE
  98. ENDDO
  99. *
  100. PROCEDURE ddisplay
  101.    SET text on
  102.    SCREEN 1
  103.    change=0
  104.    mdate=date(6)
  105.    macct2=blank(6)
  106.    DO WHILE t
  107.       SELECT 3
  108.       SET talk off
  109.       FIND sdavcHGJ
  110.       WINDOW
  111.       ii=ii+1
  112.       :color=b2[mod(ii,10)+1]
  113.       ERASE
  114.       SELECT 3
  115.       macct=macct2
  116.       ans='Y'
  117.       @ 1,0 say date(4)+cen('General Ledger Account Inquiry',50)
  118.       CURSOR 2,10
  119.       TEXT
  120. .. change,999999999.99
  121. .. ans,!
  122. .. macct,999 999
  123. Acct: @macct   (Leave blank to return to menu.)
  124.                                                                          .
  125. Name ............... #name
  126.                                           ┌──────────────────────────────┐
  127. Opening Balance .... #open                │       Correct Account?       │
  128. Change ............. #change              │    Answer with 1st Letter    │
  129. Closing Balance .... #amount              │    (Yes/No/Quit/Browse) @ans │
  130.                                           └──────────────────────────────┘
  131.       ENDTEXT
  132.       ON field
  133.       FIELD 0
  134.          change=open-amount
  135.       FIELD 1
  136.          IF macct=' '
  137.             :field=64
  138.          ELSE
  139.             SET talk off
  140.             FIND &macct
  141.             IF #=0
  142.                IF :near>0
  143.                ELSE
  144.                   GOTO :near
  145.                ENDIF
  146.                GOTO bottom
  147.             ENDIF
  148.             macct=acct
  149.          ENDIF
  150.       FIELD 6
  151.          DO CASE
  152.          CASE @(ans,'BQ')>0
  153.             :field=64
  154.          CASE ans<>'Y'
  155.             :field=1
  156.          ENDCASE
  157.       ENDON
  158.       READ
  159.       DO CASE
  160.       CASE :field=64 .and. ans="B"
  161.          SET save off
  162.          ii=ii+1
  163.          :color=b2[mod(11,10)+1]
  164.          WIND 12,22 blank
  165.          TEXT
  166.                  Account        Account Name
  167.  
  168.                  @acct          @name
  169.          ENDTEXT
  170.          BROWSE off
  171.          SET save on
  172.          macct2=acct
  173.          LOOP
  174.       CASE :field=64
  175.          BREAK
  176.       ENDCASE
  177.       macct2=blank(6)
  178.       SELECT 4
  179.       SET talk off
  180.       FIND &macct
  181.       IF #<>0
  182.          SCOPE acct
  183.          SET save off
  184.          ii=ii+1
  185.          :color=b2[mod(11,10)+1]
  186.          WIND 12,22 blank
  187.          TEXT
  188.  ACCT   DATE        DESCRIPTION                  INVOICE       AMOUNT
  189.  
  190.  %acct %mdate %desc %invoice %amount
  191.          ENDTEXT
  192.          ON field
  193.          FIELD 0
  194.             mdate=date(6,date)
  195.          ENDON
  196.          BROWSE off
  197.          SET save on
  198.          WINDOW
  199.          SCOPE
  200.       ENDIF
  201.       SELECT 3
  202.    ENDDO
  203.    WIND
  204.    SCOPE
  205.    SET save on
  206.    SELECT 1
  207. ENDPROCEDURE ddisplay
  208. *
  209. *                        *** end of program DEMODISP.PRG ***
  210.